home *** CD-ROM | disk | FTP | other *** search
/ Libris Britannia 4 / science library(b).zip / science library(b) / PROGRAMM / PASCAL / 1372.ZIP / PIBCAT.ARC / PIBCATL.PAS < prev    next >
Pascal/Delphi Source File  |  1988-10-28  |  17KB  |  407 lines
  1. (*----------------------------------------------------------------------*)
  2. (*   Display_Lbr_Contents --- Display contents of library (.LBR) file   *)
  3. (*----------------------------------------------------------------------*)
  4.  
  5. PROCEDURE Display_Lbr_Contents( LbrFileName : AnyStr );
  6.  
  7. (*----------------------------------------------------------------------*)
  8. (*                                                                      *)
  9. (*    Procedure: Display_Lbr_Contents                                   *)
  10. (*                                                                      *)
  11. (*    Purpose:   Displays contents of a library file (.LBR file)        *)
  12. (*                                                                      *)
  13. (*    Calling sequence:                                                 *)
  14. (*                                                                      *)
  15. (*       Display_Lbr_Contents( LbrFileName : AnyStr );                  *)
  16. (*                                                                      *)
  17. (*          LbrFileName --- name of library file whose contents         *)
  18. (*                          are to be listed.                           *)
  19. (*                                                                      *)
  20. (*    Calls:                                                            *)
  21. (*                                                                      *)
  22. (*       Aside from internal subroutines, these routines are required:  *)
  23. (*                                                                      *)
  24. (*          Dir_Convert_Date_And_Time                                   *)
  25. (*                            --- convert DOS packed date/time to string*)
  26. (*          Open_File         --- open a file                           *)
  27. (*          Close_File        --- close a file                          *)
  28. (*          Entry_Matches     --- Perform wildcard match                *)
  29. (*          Display_Page_Titles                                         *)
  30. (*                            --- Display titles at top of page         *)
  31. (*          DUPL              --- Duplicate a character into a string   *)
  32. (*                                                                      *)
  33. (*----------------------------------------------------------------------*)
  34.  
  35. (*----------------------------------------------------------------------*)
  36. (*              Map of Library file (.LBR) entry header                 *)
  37. (*----------------------------------------------------------------------*)
  38.  
  39. TYPE
  40.    Lbr_Entry_Type = RECORD
  41.                        Flag  : BYTE                   (* LBR - Entry flag *);
  42.                        Name  : ARRAY[1 .. 8] OF CHAR  (* File name *);
  43.                        Ext   : ARRAY[1 .. 3] OF CHAR  (* Extension *);
  44.                        Offset: WORD                   (* Offset within Library *);
  45.                        N_Sec : WORD                   (* Number of 128-byte sectors *);
  46.                        CRC   : WORD                   (* CRC (optional) *);
  47.                        Date  : WORD                   (* # days since 1/1/1978 *);
  48.                        UDate : WORD                   (* Date of last update *);
  49.                        Time  : WORD                   (* Packed time *);
  50.                        UTime : WORD                   (* Time of last update *);
  51.                        Pads  : ARRAY[1 .. 6] OF CHAR  (* Currently unused *);
  52.                     END;
  53.  
  54. CONST
  55.    Lbr_Header_Length = 32          (* Length of library file header entry *);
  56.  
  57. VAR
  58.    LbrFile       : FILE            (* Library file *);
  59.    Lbr_Entry     : Lbr_Entry_Type  (* Header describing one file in library *);
  60.    Lbr_Pos       : LONGINT         (* Current byte position in library *);
  61.    Lbr_Dir_Size  : INTEGER         (* # of entries in library directory *);
  62.    Bytes_Read    : INTEGER         (* # bytes read at current file position *);
  63.    Ierr          : INTEGER         (* Error flag *);
  64.    Do_Blank_Line : BOOLEAN         (* TRUE to print blank line before entry *);
  65.  
  66. (*----------------------------------------------------------------------*)
  67. (*      Get_Next_Lbr_Entry --- Get next header entry in library         *)
  68. (*----------------------------------------------------------------------*)
  69.  
  70. FUNCTION Get_Next_Lbr_Entry( VAR LbrEntry : Lbr_Entry_Type;
  71.                              VAR Error    : INTEGER ) : BOOLEAN;
  72.  
  73. VAR
  74.    Month : INTEGER;
  75.    Year  : INTEGER;
  76.    Done  : BOOLEAN;
  77.    T     : INTEGER;
  78.                                    (* # of days in each month *)
  79. (* STRUCTURED *) CONST
  80.    NDays : ARRAY[1..12] OF INTEGER = ( 31, 28, 31, 30, 31, 30,
  81.                                        31, 31, 30, 31, 30, 31  );
  82.  
  83. BEGIN (* Get_Next_Lbr_Entry *)
  84.                                    (* Assume no error *)
  85.    Error := 0;
  86.                                    (* Loop over directory entries *)
  87.    REPEAT
  88.                                    (* Decrement directory entry count. *)
  89.                                    (* If = 0, reached end of directory *)
  90.                                    (* entries.                         *)
  91.  
  92.       Lbr_Dir_Size := PRED( Lbr_Dir_Size );
  93.       IF ( Lbr_Dir_Size < 0 ) THEN
  94.          Error := End_Of_File;
  95.                                    (* If not end of entries ... *)
  96.       IF ( Error = 0 ) THEN
  97.          BEGIN
  98.                                    (* If not first time, move to next   *)
  99.                                    (* directory entry position in file. *)
  100.  
  101.             IF ( Lbr_Pos <> 0 ) THEN
  102.                Seek( LbrFile, Lbr_Pos );
  103.  
  104.                                    (* Read directory entry *)
  105.  
  106.             BlockRead( LbrFile, Lbr_Entry, SizeOf( Lbr_Entry ), Bytes_Read );
  107.             Error := 0;
  108.                                    (* If wrong length, .LBR format must *)
  109.                                    (* be incorrect.                     *)
  110.  
  111.             IF ( Bytes_Read < Lbr_Header_Length ) THEN
  112.                Error := Format_Error
  113.             ELSE
  114.                                    (* If length OK, assume entry OK. *)
  115.                WITH Lbr_Entry DO
  116.                   BEGIN
  117.                                    (* Point to next .LBR entry in file *)
  118.  
  119.                      Lbr_Pos := Lbr_Pos + Lbr_Header_Length;
  120.  
  121.                                    (* Pick up time/date of creation this *)
  122.                                    (* entry if specified.  If the update *)
  123.                                    (* time/date is different, then we    *)
  124.                                    (* will report that instead.          *)
  125.  
  126.                      IF ( Time = 0 ) THEN
  127.                         BEGIN
  128.                            Time := UTime;
  129.                            Date := UDate;
  130.                         END
  131.                      ELSE
  132.                         IF ( ( Time <> UTime ) OR ( Date <> UDate ) ) THEN
  133.                            BEGIN
  134.                               Time := UTime;
  135.                               Date := UDate;
  136.                            END;
  137.                                    (* Convert date from library format of *)
  138.                                    (* # days since 1/1/1978 to DOS format *)
  139.                      Month := 1;
  140.                      Year  := 78;
  141.                                    (* This is done using brute force. *)
  142.                      REPEAT
  143.                                    (* Account for leap years *)
  144.  
  145.                         T    := 365 + ORD( Year MOD 4 = 0 );
  146.  
  147.                                    (* See if we have less than 1 year left *)
  148.  
  149.                         Done := ( Date < T );
  150.  
  151.                         IF ( NOT Done ) THEN
  152.                            BEGIN
  153.                               Year := SUCC( Year );
  154.                               Date := Date - T;
  155.                            END;
  156.  
  157.                      UNTIL Done;
  158.                                    (* Now get months and days within year *)
  159.                      REPEAT
  160.  
  161.                         T    := Ndays[Month] +
  162.                                 ORD( ( Month = 2 ) AND ( Year MOD 4 = 0 ) );
  163.  
  164.                         Done := ( Date < T );
  165.  
  166.                         IF ( NOT Done ) THEN
  167.                            BEGIN
  168.                               Month := SUCC( Month );
  169.                               Date  := Date - T;
  170.                            END;
  171.  
  172.                      UNTIL Done;
  173.                                    (* If > 1980, convert to DOS date *)
  174.                                    (* else leave unconverted.        *)
  175.  
  176.                      IF ( Year >= 80 ) THEN
  177.                         Date := ( Year - 80 ) SHL 9 + Month SHL 5 + Date
  178.                      ELSE
  179.                         Date := 0;
  180.  
  181.                   END (* With *);
  182.  
  183.          END   (* Error = 0 *);
  184.  
  185.    UNTIL ( ( Error <> 0 ) OR ( Lbr_Entry.Flag = 0 ) );
  186.  
  187.                                    (* Report success/failure to caller *)
  188.  
  189.    Get_Next_Lbr_Entry := ( Error = 0 );
  190.  
  191. END   (* Get_Next_Lbr_Entry *);
  192.  
  193. (*----------------------------------------------------------------------*)
  194. (*      Display_Lbr_Entry --- Display .LBR entry file data              *)
  195. (*----------------------------------------------------------------------*)
  196.  
  197. PROCEDURE Display_Lbr_Entry( Lbr_Entry : Lbr_Entry_Type );
  198.  
  199. VAR
  200.    SDate      : STRING[10];
  201.    STime      : STRING[12];
  202.    I          : INTEGER;
  203.    FName      : AnyStr;
  204.    RLength    : LONGINT;
  205.    RSize      : LONGINT;
  206.    DateTime   : LONGINT;
  207.    DTWord     : ARRAY[1..2] OF WORD ABSOLUTE DateTime;
  208.  
  209. BEGIN (* Display_Lbr_Entry *)
  210.  
  211.    WITH Lbr_Entry DO
  212.       BEGIN
  213.                                    (* Pick up file name *)
  214.  
  215.          FName := TRIM( Name );
  216.  
  217.          IF ( Ext <> '   ' ) THEN
  218.             FName   := FName + '.' + Ext;
  219.  
  220.                                    (* See if this file matches the   *)
  221.                                    (* entry spec wildcard.  Exit if  *)
  222.                                    (* not.                           *)
  223.  
  224.          IF Use_Entry_Spec THEN
  225.             IF ( NOT Entry_Matches( Fname ) ) THEN
  226.                EXIT;
  227.  
  228.                                    (* Make sure room on current page *)
  229.                                    (* for this entry name.           *)
  230.                                    (* If enough room, print blank    *)
  231.                                    (* line if requested.  This will  *)
  232.                                    (* only happen for first file.    *)
  233.          IF Do_Blank_Line THEN
  234.             BEGIN
  235.                IF ( Lines_Left < 2 ) THEN
  236.                   Display_Page_Titles
  237.                ELSE
  238.                   BEGIN
  239.                      WRITELN( Output_File );
  240.                      DEC( Lines_left );
  241.                   END;
  242.                Do_Blank_Line := FALSE;
  243.             END
  244.          ELSE
  245.             IF ( Lines_Left < 1 ) THEN
  246.                Display_Page_Titles;
  247.  
  248.                                    (* Add '. ' to front if we're     *)
  249.                                    (* expanding LBRs in main listing *)
  250.          IF Expand_Libs_In THEN
  251.             Fname := '. ' + Fname;
  252.  
  253.                                    (* Write out file name *)
  254.  
  255.          WRITE( Output_File , Left_Margin_String , '      ' , FName );
  256.  
  257.          FOR I := LENGTH( FName ) TO 14 DO
  258.             WRITE( Output_File , ' ' );
  259.  
  260.                                    (* Convert length in sectors to *)
  261.                                    (* length in bytes.             *)
  262.  
  263.          RLength := N_Sec * 128;
  264.          WRITE( Output_File , RLength:8, '  ' );
  265.  
  266.                                    (* If time/date specified, output *)
  267.                                    (* them.                          *)
  268.          IF ( Date > 0 ) THEN
  269.             BEGIN
  270.                DTWord[1] := Time;
  271.                DTWord[2] := Date;
  272.                Dir_Convert_Date_And_Time( DateTime , SDate , STime );
  273.             END
  274.          ELSE
  275.             BEGIN
  276.                SDate := '        ';
  277.                STime := '        ';
  278.             END;
  279.  
  280.          WRITE( Output_File , SDate, '  ' );
  281.          WRITE( Output_File , STime );
  282.          WRITELN( Output_File );
  283.  
  284.                                    (* Count lines left on page *)
  285.          IF Do_Printer_Format THEN
  286.             DEC( Lines_Left );
  287.  
  288.                                    (* Increment total entry count *)
  289.  
  290.          INC( Total_Entries );
  291.  
  292.                                    (* Increment total space used  *)
  293.  
  294.          Total_ESpace := Total_ESpace + RLength;
  295.  
  296.       END;
  297.  
  298. END (* Display_Lbr_Entry *);
  299.  
  300. (*----------------------------------------------------------------------*)
  301.  
  302. BEGIN (* Display_Lbr_Contents *)
  303.  
  304.                                    (* Set library left margin spacing *)
  305.  
  306.    Left_Margin_String := Left_Margin_String + DUPL( ' ' , Library_Indent );
  307.  
  308.                                    (* Set file title *)
  309.  
  310.    File_Title := Left_Margin_String + ' Library file: ' + LbrFileName;
  311.  
  312.                                    (* Display library file's name *)
  313.    IF Do_Printer_Format THEN
  314.       IF Lines_Left < 3 THEN
  315.          Display_Page_Titles;
  316.                                    (* If we're listing contents at end  *)
  317.                                    (* of directory, print library name. *)
  318.                                    (* Do_Blank_Line flags whether we    *)
  319.                                    (* need to print blank line in entry *)
  320.                                    (* lister subroutine.  If listing    *)
  321.                                    (* inline, then it's true for the    *)
  322.                                    (* first file; otherwise it's false. *)
  323.                                    (* This is to prevent unnecessary    *)
  324.                                    (* blank lines in output listing     *)
  325.                                    (* when no files are selected from   *)
  326.                                    (* a given library.                  *)
  327.    IF ( NOT Expand_Libs_In ) THEN
  328.       BEGIN
  329.          WRITELN( Output_File ) ;
  330.          WRITE  ( Output_File , File_Title );
  331.          DEC( Lines_Left , 2 );
  332.          Do_Blank_Line := FALSE;
  333.       END
  334.    ELSE
  335.       Do_Blank_Line := TRUE;
  336.                                    (* Open library file *)
  337.  
  338.    Open_File( LbrFileName , LbrFile, Lbr_Pos, Ierr );
  339.  
  340.                                    (* Set # directory entries = 1 so   *)
  341.                                    (* we can process actual directory. *)
  342.    Lbr_Dir_Size := 1;
  343.                                    (* Issue error message if library file *)
  344.                                    (* can't be opened.                    *)
  345.    IF ( Ierr <> 0 ) THEN
  346.       BEGIN
  347.          WRITELN( Output_File ,
  348.                   DUPL( ' ' , MAX( 0 , MIN( 12 , 13 - LENGTH( LbrFileName ) ) ) ),
  349.                   '     Can''t open library file ',LbrFileName );
  350.          IF Do_Printer_Format THEN
  351.             BEGIN
  352.                DEC( Lines_Left );
  353.                IF ( Lines_Left < 1 ) THEN
  354.                   Display_Page_Titles;
  355.             END;
  356.          EXIT;
  357.       END
  358.    ELSE IF ( NOT Expand_Libs_In ) THEN
  359.       BEGIN
  360.  
  361.          WRITELN( Output_File );
  362.          WRITELN( Output_File );
  363.                                    (* Count lines left on page *)
  364.          IF Do_Printer_Format THEN
  365.             DEC( Lines_Left );
  366.  
  367.       END;
  368.                                    (* Pick up actual number of entries *)
  369.                                    (* in library.                      *)
  370.  
  371.    IF ( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) THEN
  372.       WITH Lbr_Entry DO
  373.          IF ( ( ( Flag OR Offset ) = 0 ) AND ( N_Sec <> 0 ) ) THEN
  374.             Lbr_Dir_Size := PRED( N_Sec * 4 )
  375.          ELSE
  376.             Ierr := Format_Error;
  377.  
  378.                                    (* Loop over library entries and print *)
  379.                                    (* information about each entry.       *)
  380.    IF( Ierr = 0 ) THEN
  381.       WHILE( Get_Next_Lbr_Entry( Lbr_Entry , Ierr ) ) DO
  382.          Display_Lbr_Entry( Lbr_Entry );
  383.  
  384.                                    (* Print blank line after last entry   *)
  385.                                    (* in library, if we're expanding      *)
  386.                                    (* libraries right after listing them, *)
  387.                                    (* but only if library had any entries *)
  388.                                    (* listed.                             *)
  389.  
  390.    IF ( Expand_Libs_In AND ( NOT Do_Blank_Line ) ) THEN
  391.       BEGIN
  392.          WRITELN( Output_File );
  393.          IF Do_Printer_Format THEN
  394.             DEC( Lines_Left );
  395.       END;
  396.  
  397.                                    (* Close library file *)
  398.    Close_File( LbrFile );
  399.                                    (* Restore previous left margin spacing *)
  400.  
  401.    Left_Margin_String := DUPL( ' ' , Left_Margin );
  402.  
  403.                                    (* No file title *)
  404.    File_Title := '';
  405.  
  406. END   (* Display_Lbr_Contents *);
  407.